perm filename CNTOUR.FAI[XGP,BGB] blob
sn#033596 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001 CNTOUR.FAI[XGP,TVR]
C00002 00002 SUBR(THRESH)------------------------------------------------------
C00004 00003 SUBR(HISTOG)---------------------------------------------------
C00005 00004 SUBR(MKPGON)LEVEL--------------------------------------------------
C00008 00005 THE SUB-OPERATIONS OF MKPGON.
C00009 00006 THE ALCHEMIST OF MKPGON - converts bits of lead into lines of gold.
C00012 00007 NSUBR(SETKINK)
C00013 ENDMK
C⊗;
SUBR(THRESH)------------------------------------------------------
BEGIN THRESH;THRESHOLD(LEVEL) pre foonly version. BGB 4 DEC 1972.
SKIPE FLGKRK↔DETSEG
;SOUBIT TO PAC FOR PIXELS ≥ CUT.
I←13 ↔ J←14
CALL(SEGTV)
MOVE [XWD L,2]↔BLT 13
MOVE ARG1↔MOVEM HCUT
HRR 5,ARG1
GO 3
;ACCUMULATOR LOOP.
L: POINT 6,TVBUF,-1
MOVEI J,=36 ;3
ILDB 2 ;4
SUBI ;CUT ;5
ROTC 1 ;6
SOJG J,4 ;7
SETCAM 1,PAC(I) ;10
AOBJN I,3 ;11
POP1J ;12
XWD -=1728,0 ;13
BEND;12/17/72-----------------------------------------------------
HCUT: 0 ;HCUT GLOBAL FROM THRESH TO MKPGONS.
SUBR(PACXOR)------------------------------------------------------
BEGIN PACXOR;do rook's exclusive OR'ing. BGB 4-DEC-72.
I←2
MOVSI PAC↔LAPI HSEG↔BLT HSEG+=1727
MOVSI PAC↔LAPI VSEG↔BLT VSEG+=1727
SETZ I,
HRRI PAC↔HRRM L+2
L: TRNN I,7↔SETZ 1,↔MOVE PAC(I)
XORM HSEG+8(I) ; HSEG SOUBIT are above PAC bits.
ROTC -1↔ROT 1,1
XORM VSEG(I) ; VSEG are left of PAC bits.
AOS I
CAIE I,=1728
GO L
SETZM ISAVED
POP0J
BEND;12/4/72------------------------------------------------------
SUBR(HISTOG)---------------------------------------------------
BEGIN HISTOG;MAKE HISTOGRAM OF TVBUF - BGB - 4 DEC 72.
CALL(SEGTV)
SKIPE FTVHIS↔POP0J↔SETOM FTVHIS
MOVE[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
MOVE 10,[XWD L,0]↔BLT 10,7↔GO 2
;ACCUMULATOR LOOP.
L: =62208 ;0
0 ;1
ILDB 1,6 ;2
AOS HISTO(1) ;3
SOJG 0,2 ;4
POP0J ;5
POINT 6,TVBUF,-1;6
BEND;12/16/72-----------------------------------------------------
SUBR(MKPGON)LEVEL--------------------------------------------------
BEGIN MKPGON;MAKE AN INTENSITY CONTOUR POLYGON - BGB - AUGUST 1972.
ACCUMULATORS{A2,A3,RC.,MASK,I,PTR,D,E,V,PG,BITQ,H1,H2}
; MOVE H1,HCUT↔LSH H1,-3↔MOVEI H2,7↔SUB H2,H1
MOVE I,ISAVED↔HRRZ PTR,ARG1↔MOVEI BITQ,VREL
MOVSI I↔HRRI PAC↔MOVEM PACPTR#; PAC POINTER INDEXED BY I.
;FIND THE ROW & COL OF THE UPPER LEFT MOST VSEG.
L1: SKIPE 1,VSEG(I)↔GO L2
AOS I↔CAIE I,=1728↔GO L1
SETZ 1,↔POP1J;EMPTY.
L2: MOVEM I,ISAVED↔JFFO 1,.+1↔MOVSI MASK,400000
MOVNS 2↔LSH MASK,(2)↔MOVNS 2
MOVE RC.,I↔ANDI RC.,7↔IMULI RC.,=36↔ADD RC.,2 ;COLUMN.
MOVE I↔LSH -3↔HRLM RC.↔LSH RC.,6 ;ROW.
;DISTINGUISH BLOBS FROM HOLES.
SETZM HOLE#
TDNN MASK,@PACPTR ;HOLE OR BLOB ?
SETOM HOLE# ;HOLE'A'COMING.
SKIPE FNTFLG↔SETCMM HOLE ;COMPLIMENT HOLE FLAG FOR CHARACTERS FROM FONT
SKIPE HOLE↔EXCH H1,H2
;AND HEAD SOUTH.
SETQ(PG,{MAKE,[PBIT+PGNREL]})
MOVE 0,ARG1↔DAD. 0,PG↔CALL(RINGIN,PG,0)
SKIPE HOLE↔GO[MARK PG,HOLBIT↔GO .+1]
MOVEM RC.,RCMIN#
SETZM RCMAX#
SETZ V,↔SETZM ECNT#
PUSHJ P,FOLLOW
MOVE V,V0
CCW. V,E↔CW. E,V
;MAKE & RETURN VIC POLYGON.
MOVE 1,ECNT↔SKIPE HOLE#↔MOVNS 1
NCNT. 1,PG
MOVE V0↔SON. 0,PG ;UPPER MOST LEFT.
MOVE V1↔ARC. 0,PG ;LOWER MOST RIGHT.
MOVE 1,PG
L3: POP1J
;THE SUB-OPERATIONS OF MKPGON.
DEFINE TRY (SEG,YES) {
MOVE SEG(I)↔TDZN MASK↔GO .+3↔MOVEM SEG(I)↔GO YES}
DEFINE LEFT {SUBI RC.,100↔ROT MASK,1↔CAIN MASK,1↔SOS I}
DEFINE RIGHT {ADDI RC.,100↔ROT MASK,-1↔SKIPG MASK↔AOS I}
DEFINE UP {SUB RC.,[1B11]↔SUBI I,8}
DEFINE DOWN {ADD RC.,[1B11]↔ADDI I,8}
;CREATE NEW EDGE AND VERTEX OF A VIC.
TURN: 0
AOS TURNS#
ADD D,RC.
AOS 2,ECNT
;VERTEX
CALL MAKE,BITQ
PGON. PG,1
SKIPN V↔GO[MOVEM 1,V0#↔MOVEM 1,V↔GO T2]
MOVEM 1,V
CCW. V,E↔CW. E,V
T2: MOVEM D,RC(V)
CAMLE D,RCMAX
GO[MOVEM D,RCMAX↔MOVEM V,V1#↔GO .+1]
MOVEM V,E
GO @TURN
;THE ALCHEMIST OF MKPGON - converts bits of lead into lines of gold.
NORTH: ADD D,[1B11]↔LIPI BITQ,(NORBIT+VBIT)↔JSR TURN
;NORTH2: LEFT↔MOVE D,DELPM(H1)↔ TRY HSEG,WEST
NORTH2: LEFT↔MOVE D,DELPM↔ TRY HSEG,WEST
RIGHT↔UP↔ TRY VSEG,NORTH2
; DOWN↔MOVE D,DELPP(H2)↔ TRY HSEG,EAST↔FATAL(NORTH)
DOWN↔MOVE D,DELPP↔ TRY HSEG,EAST↔FATAL(NORTH)
NORTH3: LIPI BITQ,(NORBIT+VBIT)↔JSR TURN↔LEFT
;NORTH4: UP↔MOVE D,DELPM(H1)↔ TRY HSEG,WEST↔GO NORTH4
NORTH4: UP↔MOVE D,DELPM↔ TRY HSEG,WEST↔GO NORTH4
WEST: ADDI D,100↔LIPI BITQ,(WESBIT+VBIT)↔JSR TURN
WEST2: CAMN RC.,RCMIN↔POPJ P,;TRY FOR E.O.VIC.
;FOLLOW: MOVE D,DELPP(H1)↔ TRY VSEG,SOUTH
FOLLOW: MOVE D,DELPP↔ TRY VSEG,SOUTH
LEFT↔ TRY HSEG,WEST2
; RIGHT↔UP↔MOVE D,DELMP(H2)↔TRY VSEG,NORTH↔FATAL(WEST)
RIGHT↔UP↔MOVE D,DELMP↔TRY VSEG,NORTH↔FATAL(WEST)
SOUTH: LIPI BITQ,(SOUBIT+VBIT)↔JSR TURN
;SOUTH2: DOWN↔MOVE D,DELMP(H1)
SOUTH2: DOWN↔MOVE D,DELMP
HLRZ RC.↔CAIN =216B29↔GO EAST3
TRY HSEG, EAST
TRY VSEG,SOUTH2
; LEFT↔MOVE D,DELMM(H2)↔ TRY HSEG,WEST↔ FATAL(SOUTH)
LEFT↔MOVE D,DELMM↔ TRY HSEG,WEST↔ FATAL(SOUTH)
EAST: LIPI BITQ,(EASBIT+VBIT)↔JSR TURN
;EAST2: RIGHT↔MOVE D,DELMM(H1)
EAST2: RIGHT↔MOVE D,DELMM
HRRZ RC.↔CAIN =288B29↔GO NORTH3
UP↔ TRY VSEG,NORTH
DOWN↔ TRY HSEG,EAST2
; MOVE D,DELPM(H2)↔ TRY VSEG,SOUTH↔FATAL(EAST)
MOVE D,DELPM↔ TRY VSEG,SOUTH↔FATAL(EAST)
EAST3: LIPI BITQ,(EASBIT+VBIT)↔JSR TURN↔UP
;EAST4: RIGHT↔MOVE D,DELMM(H1)
EAST4: RIGHT↔MOVE D,DELMM
HRRZ RC.↔CAIN =288B29↔GO[DOWN↔GO NORTH3]
TRY VSEG,NORTH↔GO EAST4
BEND;12/14/72-----------------------------------------------------
NSUBR(SETKINK)
CALL(REALIN)
FIXX 0,
JUMPE 0,[POP0J]
MOVE 2,[XWD -4,DELPP]
LOOP: HRRE 1,(2)
JUMPL 1,[MOVN 1,0
HRRM 1,(2)
GO L1]
HRRM 0,(2)
L1: SKIPL (2)
SKIPA 1,0
MOVN 1,0
HRLM 1,(2)
AOBJN 2,LOOP
POP0J
SUBREND SETKINK
;DEKINKING OFF SETS.
; DELPP: FOR I←24,33{XWD I,I↔}
; DELPM: FOR I←24,33{XWD I,-I↔}
; DELMP: FOR I←24,33{XWD -I,I↔}
; DELMM: FOR I←24,33{XWD -I,-I↔}
INTERNAL DELPP
DELPP: XWD 22,22
DELPM: XWD 22,-22
DELMP: XWD -22,22
DELMM: XWD -22,-22